{-# LANGUAGE PatternGuards              #-}
{-# OPTIONS -Wall #-}

--------------------------------------------------------------------------------
-- |
-- Module      :  Text.ZFormat.Combinators
-- Copyright   :  (c) Stephen Tetley 2012
-- License     :  BSD3
--
-- Maintainer  :  stephen.tetley@gmail.com
-- Stability   :  unstable
-- Portability :  GHC
--
-- Combinators for formatted output like pretty printers but 
-- without the automatic prettiness (width fitting).
--
-- Formatting combinators format nesting and breaking directly
-- rather than interpret breaking to produce a best fit with 
-- respect to line width.
--
--------------------------------------------------------------------------------

module Text.ZFormat.Combinators
  (

    int
  , integer

  , word8
  , word16
  , word32

  , nat2
  , nat4


  -- * Punctuation
  , space
  , comma
  , dot
  , colon
  , semicolon
  , equals

  , lparen
  , rparen
  , lbracket
  , rbracket
  , lbrace
  , rbrace
  , langle
  , rangle


  , punctuate
  , hcat
  , hsep
  , vcat

  , text
  , char

  , enclose
  , squotes
  , dquotes
  , parens
  , brackets
  , braces
  , angles


  , list
  , tupled
  , semiBraces


  , widthRuler
  , numberLine
    
  ) where


import Text.ZFormat.Base

import Data.Word
import qualified Numeric as Num


--------------------------------------------------------------------------------
-- Utils


repChar :: Int -> Char -> ShowS
repChar i c | i <= 0    = id
            | otherwise = showString (replicate i c)

--------------------------------------------------------------------------------
-- Numbers

-- | Show the Int as a Doc.
--
-- > int  = text . show
--
int :: Int -> Doc
int = text . show


-- | Show the Integer as a Doc.
--
-- > integer  = text . show
--
integer :: Integer -> Doc
integer = text . show



-- | Padded to two chars, i.e.
--
-- > word8 12 == "0c"
--
word8           :: Word8 -> Doc
word8 i | i < 16    = textS $ ('0':) . Num.showHex i
        | otherwise = textS $ Num.showHex i



-- | Padded to four chars, i.e.
--
-- > word16 12 == "000c"
--
word16          :: Word16 -> Doc
word16 i | i < 16    = textS $ (repChar 3 '0') . Num.showHex i
         | i < 256   = textS $ (repChar 2 '0') . Num.showHex i
         | i < 4096  = textS $ ('0':)             . Num.showHex i
         | otherwise = textS $ Num.showHex i





-- | Padded to 32 chars, i.e.
--
-- > word132 12 == "0000000c"
--
word32          :: Word32 -> Doc
word32 i | i < 16     = textS $ (repChar 7 '0') . Num.showHex i
         | i < 256    = textS $ (repChar 6 '0') . Num.showHex i
         | i < 4096   = textS $ (repChar 5 '0') . Num.showHex i
         | i < (16*4) = textS $ (repChar 4 '0') . Num.showHex i
         | i < (16*5) = textS $ (repChar 3 '0') . Num.showHex i
         | i < (16*6) = textS $ (repChar 2 '0') . Num.showHex i
         | i < (16*7) = textS $ ('0':)             . Num.showHex i
         | otherwise  = textS $ Num.showHex i



-- | Padded to two chars, i.e.
--
-- > nat2 6 == "06"
--
-- Negative numbers are printed as-is.
-- 
nat2            :: Integral i => i -> Doc
nat2 i | i < 10 && i >= 0 = textS $ ('0':) . Num.showInt i
       | otherwise        = textS $ Num.showInt i

-- | Padded to four chars, i.e.
--
-- > nat4 6 == "0006"
-- 
-- Negative numbers are printed as-is.
--
nat4            :: Integral i => i -> Doc
nat4 i | i < 10 && i >= 0 = textS $ (repChar 3 '0') . Num.showInt i
       | i < 100          = textS $ (repChar 2 '0') . Num.showInt i
       | i < 1000         = textS $ ('0':) . Num.showInt i
       | otherwise        = textS $ Num.showInt i



{-

-- | Show the Float as a Doc.
--
float :: Double -> Doc
float = Text . showFloat

-- | Show the Double as a Doc.
--
double :: Double -> Doc
double = text . showFloat
-}


--------------------------------------------------------------------------------
-- Punctuation

 
-- | Create a Doc containing a single space character.
--
space           :: Doc
space           = char ' '

-- | Create a Doc containing a comma, \",\".
--
comma           :: Doc
comma           = char ','

-- | Create a Doc containing a comma, \".\".
--
dot             :: Doc
dot             = char '.'

-- | Create a Doc containing a colon, \":\".
--
colon       :: Doc
colon       = char ':'

-- | Create a Doc containing a semi colon, \";\".
--
semicolon       :: Doc
semicolon       = char ';'


-- | Create a Doc containing an equals sign, \"=\".
--
equals          :: Doc
equals          = char '='



-- | Create a Doc containing a left paren, \'(\'.
--
lparen :: Doc
lparen = char '('

-- | Create a Doc containing a right paren, \')\'.
--
rparen :: Doc
rparen = char ')'

-- | Create a Doc containing a left square bracket, \'[\'.
--
lbracket :: Doc
lbracket = char '['

-- | Create a Doc containing a right square bracket, \']\'.
--
rbracket :: Doc
rbracket = char ']'

-- | Create a Doc containing a left curly brace, \'{\'.
--
lbrace :: Doc
lbrace = char '{'

-- | Create a Doc containing a right curly brace, \'}\'.
--
rbrace :: Doc
rbrace = char '}'

-- | Create a Doc containing a left angle bracket, \'\<\'.
--
langle :: Doc
langle = char '<'

-- | Create a Doc containing a right angle bracket, \'\>\'.
--
rangle :: Doc
rangle = char '>'



--------------------------------------------------------------------------------



punctuate :: Doc -> [Doc] -> Doc
punctuate _   []     = empty
punctuate sep (a:as) = step a as
  where
    step acc []     = acc
    step acc (x:xs) = step (acc <> sep <> x) xs

-- | Horizontally concatenate a list of documents with @(\<\>)@.
--
hcat :: [Doc] -> Doc
hcat = foldr (<>) empty

-- | Horizontally concatenate a list of documents with @(\<+\>)@.
--
hsep :: [Doc] -> Doc
hsep = punctuate space

-- | Vertically concatenate a list of documents, with a line 
-- break between each doc.
--
vcat :: [Doc] -> Doc
vcat []     = empty
vcat (x:xs) = step x xs 
  where
    step acc (z:zs) = step (acc $+$ z) zs
    step acc []     = acc


-- | Enclose the final Doc within the first two.
--
-- There are no spaces between the documents:
--
-- > enclose l r d = l <> d <> r
--
enclose :: Doc -> Doc -> Doc -> Doc
enclose l r d = l <> d <> r



-- | Enclose the Doc within single quotes.
--
squotes :: Doc -> Doc
squotes = enclose (char '\'') (char '\'')

-- | Enclose the Doc within double quotes.
--
dquotes :: Doc -> Doc
dquotes = enclose (char '"') (char '"')

-- | Enclose the Doc within parens @()@.
--
parens :: Doc -> Doc
parens = enclose lparen rparen

-- | Enclose the Doc within square brackets @[]@.
--
brackets :: Doc -> Doc
brackets = enclose lbracket rbracket

-- | Enclose the Doc within curly braces @{}@.
--
braces :: Doc -> Doc
braces = enclose lbrace rbrace

-- | Enclose the Doc within angle brackets @\<\>@.
--
angles :: Doc -> Doc
angles = enclose langle rangle



-- | Comma separate the list of documents and enclose in square
-- brackets.
--
list :: [Doc] -> Doc
list = brackets . punctuate comma

-- | Comma separate the list of documents and enclose in parens.
--
tupled :: [Doc] -> Doc
tupled = parens . punctuate comma

-- | Separate the list with a semicolon and enclose in curly 
-- braces.
--
semiBraces :: [Doc] -> Doc
semiBraces = braces . punctuate semicolon

--------------------------------------------------------------------------------

repeated :: Int -> Doc -> Doc
repeated i d = hcat $ replicate i d


widthRuler :: Int -> Doc
widthRuler w 
    | w <= 0    = empty
    | w <  6    = angles $ repeatChar (w - 2) '-'
    | even w    = angles $ spanner <+> int w <+> spanner
    | otherwise = angles $ spanner <+> int w <> space <+> spanner
  where
    sz      = 4 + length (show w)    -- 4 == 2 spaces and lreft and right angle
    sw      = (w - sz) `div` 2
    spanner = repeatChar sw '-'



numberLine :: Int -> Doc
numberLine w 
    | w <= 0    = empty
    | otherwise = let (n,rest) = w `divMod` 10        
                  in repeated n (text ss) <> text (take rest ss)
  where
    ss = "1234567890"